home *** CD-ROM | disk | FTP | other *** search
- /***************************************/
- /* Bandit.rexx Slot Machine Simulator */
- /* By: James M. Cates III Oct. 8 1990 */
- /* Arexx V1.10 By: William Hawes */
- /* Original */
- /* Game Bye: M. Soucy and M. Fox. */
- /* I found the code heavily 'munged' */
- /* So, I did this. It works. */
- /***************************************/
- /* Altered again for BBBBS:rexxDoors */
- /* By: Richard Lee Stockton 15 Mar 92 */
- /***************************************/
- /* Version 1.2 6-21-92 */
- /* Adapted to play from within Chicago */
- /* version 1.3 by Matt English 6-6-92 */
- /***************************************/
-
- CR='0D'x
- OPTIONS RESULTS
- CALL TIME('R')
- SIGNAL ON BREAK_C
- SIGNAL ON BREAK_E
-
- /* Open the support library if it is not already open. */
- if ~show('L',"rexxsupport.library") then do
- addlib('rexxsupport.library',0,-30,0)
- end
-
- if getclip('CHICMON') ~= '' then do
- CHICGAME = 1
- purse = getclip('CHICMON')
- dollarsign = '$'
- playstuff = 'CASH'
- if getclip('CHICCOLOR') = 1 then do
- red = ''
- black = ''
- white = ''
- rev = ''
- def = ''
- whred = ''
- whblk = ''
- ital = ''
- under = ''
- end
- else do
- red = ''
- black = ''
- white = ''
- rev = ''
- def = ''
- whred = ''
- whblk = ''
- ital = ''
- under = ''
- end
- call pull
- end
-
- ARG name purse flag . secs .
- IF secs='' THEN secs=2600
- IF DATATYPE(flag,'N') & flag~=0 THEN
- DO
- dollarsign=''
- playstuff='TIME SECONDS'
- END
- ELSE
- DO
- dollarsign='$'
- playstuff='CASH'
- END
-
- /**********************************************************************/
- /* ANSI.rexx */
- /* Simple ANSI color escape function assignments */
- /*--------------------------------------------------------------------*/
- /* James M. Cates Sept. 24 1990 */
- /**********************************************************************/
-
- red = "" /****************************************/
- black = "" /* These just make life easier when you */
- white = "" /* want some color output. */
- rev = "" /****************************************/
- def = ""
- whred = ""
- whblk = ""
- ital = ""
- under = ""
-
-
- say ' 'CR
- say ' 'CR
- if purse>0 then
- say ' Welcome back to the Casino!'CR
- else
- say ' Welcome to the Casino!'CR
- say ' 'CR
- say rev'***********************************************************************'CR
- say '* __ ___ _ __ __ _ __ _ _ ___ ___ *'CR
- say '* / \ |\ | |_ /_\ |__| |\/| |_ | \ |__\ /_\ |\ | | \ | | *'CR
- say '* \__/ | \| |__ / \| \ | | |__ |_/ |__/ / \| \| |_/ _|_ | *'CR
- say '* *'CR
- say '* Revision: Version 1.2 6-21-92 By: Matt English *'CR
- say '* Revision: Version 1.0 1990 By: James M. Cates III *'CR
- say '* Original: Version 0.81 1989 By: M.Soucy and M.Fox *'CR
- say '* *'CR
- say '***********************************************************************'def||CR
- say ' 'CR
- say ' 'CR
- if purse>0 then call name
- say 'Do you need Instructions 'red'('def'Y'red'/'def'N'red')'def' ?'CR
- arg
- ans=readstr()
- do i = 1 to 100
- if ans = 'Y' then call inst
- else call name
- do i = 1 to 100
-
- inst:
- say ' 'CR
- say ital'C''mon now, this is a simple game. You just follow my prompts.'CR
- say 'I''ll do all the real work, all you really have to do is place your bet.'CR
- say ' 'CR
- say 'The symbols for each slot are a bit funny, they are only symb-'CR
- say 'bolic, so don''t worry. I did not feel like doing ascii represen-'CR
- say 'ations of FRUIT...'def||CR
- call play
-
- play:
- say ' 'CR
- say 'Do you want to play 'red'('def'Y'red'/'def'N'red')'def' ?'CR
- arg
- ans=readstr()
- if ans = 'Y' then call name
- if ans = 'N' then call death
- do i = 1 to 100
-
- name:
- if purse <10 then purse = 100
- bet = 0
- Tl = 0
- Dl = 0
- call Pull
-
- Pull:
- CALL checkBBS()
- say ' 'CR
- if purse = 0 then call rating
- if chicgame = 1 then do
- prompt(' 'red'How much cash would you like to bet? > $'def'')
- bet=readstr()
- end
- else do
- prompt( "Purse =" dollarsign||red||purse||def" Your bet please "red":"def"")
- Bet=readstr()
- end
- if bet > 500 then do
- say ''cr
- say' Sorry Bud, there''s a $500 dollar limit at this machine!'cr
- call pull
- end
- if Bet > purse then
- do
- say ' 'CR
- say "Sorry "red||name||def" you can't bet over" dollarsign||red||purse||def||CR
- do i = 1 to 100
- end
- call Pull
- end
- else
- if Bet = 0 | Bet < 0 then call whatthehell
- else
- if Bet = '' | Bet = ' ' then call Pull
- else
- say ''cr
- say ital'Bet taken...'def||CR
- call slots
-
- slots:
- say ital'Pulling lever for 'under'BIG' playstuff'!'def||CR
- call roll
- call roll
-
- roll:
- odz=10
- x=OPEN(f,'RAM:DUMMY','W')
- CALL WRITELN(f,'DUMMY')
- CALL CLOSE(f)
- micros=STRIP(WORD(STATEF('RAM:DUMMY'),7))
- IF micros<100 THEN micros=micros+100
- micros=RIGHT(micros,3)
- slot1=(LEFT(micros,1)*(odz/10))%1
- slot2=(SUBSTR(micros,2,1)*(odz/10))%1
- slot3=(RIGHT(micros,1)*(odz/10))%1
- call stakes
-
- stakes:
- if slot1 = 0 then slot1 = '/'
- if slot1 = 1 then slot1 = '@'
- if slot1 = 2 then slot1 = '?'
- if slot1 = 3 then slot1 = '&'
- if slot1 = 4 then slot1 = '^'
- if slot1 = 5 then slot1 = '_'
- if slot1 = 6 then slot1 = '+'
- if slot1 = 7 then slot1 = '%'
- if slot1 = 8 then slot1 = '*'
- if slot1 = 9 then slot1 = '!'
- if slot2 = 0 then slot2 = '/'
- if slot2 = 1 then slot2 = '@'
- if slot2 = 2 then slot2 = '?'
- if slot2 = 3 then slot2 = '&'
- if slot2 = 4 then slot2 = '^'
- if slot2 = 5 then slot2 = '_'
- if slot2 = 6 then slot2 = '+'
- if slot2 = 7 then slot2 = '%'
- if slot2 = 8 then slot2 = '*'
- if slot2 = 9 then slot2 = '!'
- if slot3 = 0 then slot3 = '/'
- if slot3 = 1 then slot3 = '@'
- if slot3 = 2 then slot3 = '?'
- if slot3 = 3 then slot3 = '&'
- if slot3 = 4 then slot3 = '^'
- if slot3 = 5 then slot3 = '_'
- if slot3 = 6 then slot3 = '+'
- if slot3 = 7 then slot3 = '%'
- if slot3 = 8 then slot3 = '*'
- if slot3 = 9 then slot3 = '!'
- call output
-
- output:
- say ' 'CR
- say ' <'red slot1 def'> <'red slot2 def'> <'red slot3 def'>'CR
- call compare
-
- compare:
- if slot1 = slot2 & slot1 ~= slot3 then call winner1
- else
- if slot2 = slot3 & slot2 ~= slot1 then call winner1
- else
- if slot1 = slot2 & slot1 = slot3 then call winner2
- else purse = (purse - bet)
- if chicgame = 1 then do
- say''cr
- say ' Sorry, you just lost $'bet''cr
- call chicexit
- end
- call Pull
-
- winner1:
- say whred'You won double your bet!'def||CR
- purse = purse + (bet * 2)
- if chicgame = 1 then do
- say''cr
- win = (bet * 2)
- say' You just won $'win' !'cr
- call chicexit
- end
- call Pull
-
- winner2:
- say whred'You won TRIPLE your bet!'def||CR
- purse = purse + (bet * 3)
- if chicgame = 1 then do
- say''cr
- win = (bet * 3)
- say' You just won $'win' !'cr
- call chicexit
- end
- call Pull
-
- whatthehell:
- prompt( 'Do you want to continue 'red'('def'Y'red'/'def'N'red')'def' ?')
- do i = 1 to 100
- ans=readstr()
- arg
- if ans = 'Y' then call Pull
- else do
- if chicgame ~=1 then call rating
- if chicgame = 1 then call chicexit
- end
- end
-
- chicexit:
- say''cr
- call setclip('CHICMON',purse)
- exit
-
- rating:
- if purse > 2000 then RATE = 'Mr. Trump! Your jet is waiting.'
- if purse > 1500 & purse <= 2000 then RATE = 'What city are you going to buy?'
- if purse > 1000 & purse <= 1500 then RATE = 'Your wallet is fat now!'
- if purse > 750 & purse <= 1000 then RATE = 'Pretty good.'
- if purse > 500 & purse <= 750 then RATE = 'Well, you did okay.'
- if purse > 250 & purse <= 500 then RATE = 'Er..stick to monopoly, eh?'
- if purse < 250 & purse >= 100 then RATE = 'You need help!'
- if purse < 100 then RATE = 'Hope you have enough for a cab home, sucker!'
- say ' '
- say 'You had 'dollarsign||red||purse||def' before you quit!'CR
- say 'Your rating is : 'ital RATE def||CR
- do i = 1 to 200
- end
-
-
- BREAK_C:
- BREAK_E:
- death:
- say ' 'CR
- say 'You made' dollarsign||red||purse||def' today!'CR
- say 'Goodbye, 'ital||name||def'.'CR
- say ' 'CR
- CALL SETCLIP('BBS_winnings',purse)
- exit
- end
-
-
- checkBBS:
- IF ADDRESS()~='BAUD' THEN RETURN 0
- IF TIME('E')>secs THEN SIGNAL death
- dcd
- IF RC=0 THEN SIGNAL death
- temp=secs-TIME('E')
- IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR
- RETURN 0
-
- readstr: procedure
- str=''
- out=readch(STDIN)
- call WRITECH(STDOUT,out)
- do while out~=D2C(13)
- if out=D2C(8) then do
- str=SUBSTR(str,1,LENGTH(str)-1)
- call WRITECH(STDOUT,' ')
- call WRITECH(STDOUT,out)
- end
- else
- str=INSERT(str,out)
- out=readch(STDIN)
- call WRITECH(STDOUT,out)
- end
- say '0D'x
- return(UPPER(str))
-
- prompt: procedure
- parse arg str
- writech(STDOUT,str)
- return 1
-
- /* One_Armed_Bandit.rexx */
-